perm filename FLOPS.SAI[11,ALS] blob sn#063614 filedate 1973-09-21 generic text, type T, neo UTF8
00010	BEGIN "FLIPS"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,CHAN2,EOF;
00040	INTEGER ARRAY BUF,FLOPS[0:512];
00050	STRING FILEN,READ,READ1,FILEO,READ2;
00060	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00070	⊂ STATE=0 means on way up
00080	  STATE=1 means on way down;
00090	
00100	STDBRK(1);
00110	SETBREAK(14,"∃",NULL,"INS");
00120	SETBREAK(16,'56,NULL,"INA");
00130	FILEN←"FLTD.001[DAT,NJM]";
00140	OUTSTR("Type file name (CR for "&FILEN&".");
00150	IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00160	  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00170	  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00180	  IF READ2="." THEN DONE; END;
00190	  FILEO←READ1&"FRI";
00200	  POINTY←POINT(6,FLOPS[0],-1);
00210	OUTSTR("Specify DELTA (CR for 20) ");
00220	IF (READ←INCHWL)="" THEN DELTA←20 ELSE DELTA←CVD(READ);
00230	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00240	LOOKUP(CHAN1,FILEN,0);
00250	J←K←L←STATE←VAL←R←0;
00260	READ1←FILEN;
00270	CHAN2←2; CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00280	READ2←SCAN(READ1,16,J)&"DOC";
00290	ENTER(CHAN2,READ2,0);
00300	OUT(CHAN2,CRLF&"Frication measure on file "&FILEN
00310	   &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00320	OUTSTR(CRLF&"Frication measure on file "&FILEN
00330	   &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00340	SETFORMAT(6,0);
00350	FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00360	FOR I←0 STEP 1 UNTIL 9 DO OUT(CHAN2,CVS(I)); OUT(CHAN2,CRLF&LF);
00370	Q←0; P←1; OUTSTR(CVS(Q)&TB&"      ");
00380	OUT(CHAN2,CVS(Q)&TB&"      ");
00390	WHILE EOF=0 DO BEGIN
00400	  FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00410	  ARRYIN(CHAN1,BUF[0],512);
00420	  POINTX←POINT(12,BUF[0],-1);
00430	FOR I←0 STEP 1 UNTIL 11 DO BEGIN
00440	  M←0;
00450	  FOR J←0 STEP 1 UNTIL 127 DO BEGIN
00460	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00470	    IF STATE=0 THEN BEGIN
00480	      IF VAL<K-DELTA THEN BEGIN
00490	      M←M+1; STATE←-1; END; END ELSE
00500	     IF VAL>K+DELTA THEN  BEGIN
00510	      M←M+1; STATE←0; END;
00520	    K←VAL;
00530	    END;
00540	  N←M;
00550	  IF N>0 THEN OUTSTR(CVS(N)) ELSE OUTSTR("      ");
00560	  IF N>0 THEN OUT(CHAN2,CVS(N)) ELSE OUT(CHAN2,"      ");
00570	⊂  IF N>20 THEN N←N-20 ELSE N←0;
00580	  IF N≤63 THEN IDPB(N,POINTY) ELSE IDPB(63,POINTY); R←R+1;
00590	  IF (P MOD 10)=9 THEN BEGIN Q←Q+10;
00600	     OUT(CHAN2,CRLF&CVS(Q)&TB);
00610	     OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00620	  END;
00630	END;
00640	
00650	CLOSE(CHAN1); CLOSE(CHAN2); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00660	ENTER(CHAN1,FILEO,0); R←R%6+2;
00670	ARRYOUT(CHAN1,FLOPS[0],R); RELEASE(CHAN1);
00680	END "FLIPS";